home *** CD-ROM | disk | FTP | other *** search
- PROGRAM FLOPPY
- C-------------------------------------------------------------------------
- C Floppy UNIX interface routine.
- C Sets up various required input files for Floppy.
- C
- C Julian Bunn 1990
- C-------------------------------------------------------------------------
- PARAMETER (MLEN=256,MXLIN=80,maxarg=100)
- character*(mxlin) argval
- character*1 key,char
- CHARACTER*(MLEN) CFILE,COLD,CFORT,CTEMP,CBAD,CTREE
- LOGICAL LOG,fexist,fold,fqold,tidy,tree
- c
- c get all arguments
- c
- numargs = iargc()
- if(numargs.gt.maxarg) then
- write(6,'(A)') ' Floppy --> Too many arguments '
- goto 900
- endif
- c
- c get target filename(s)
- c
- call getarg(numargs,cfile)
- lfile = index(cfile,' ')-1
- write(6,'(A)') ' Floppy --> Target file '//cfile(:lfile)
- inquire(file=cfile(:lfile),exist=fexist)
- if(.not.fexist) then
- write(6,'(A)') ' Floppy --> Target file not found !'
- goto 900
- endif
- c
- log = .false.
- fold = .false.
- tidy = .false.
- cfort = ' '
- ctree = ' '
- tree = .false.
- c
- do 400 iarg=1,numargs-1
- call getarg(iarg,argval)
- if(argval(:2).eq.'-l') log = .true.
- if(argval(:2).eq.'-o') fqold = .true.
- if(argval(:2).eq.'-o') cold = argval(3:)
- 400 continue
- c
- cbad = 'scratch'
- open(7,status='scratch',err=999)
- WRITE(7,'(A)') 'LIST,GLOBAL,TYPE;'
- WRITE(7,'(A)') 'PRINT,ILLEGAL;'
- WRITE(7,'(A)') 'OPTIONS,USER;'
- if(fqold) then
- if(cold(1:1).eq.' ') cold = cfile(:lfile)//'.flopold'
- lold = index(cold,' ')-1
- inquire(file=cold(:lold),exist=fold)
- if(log) write(6,'(A)') ' Floppy --> Old file: '//cold(:lold)
- if(.not.fold) then
- write(6,'(A)') ' Floppy --> Old file not found !'
- goto 900
- endif
- cbad = cold
- open(15,file=cold,status='old',err=999)
- 450 read(15,'(A)',end=451,err=999) ctemp
- goto 450
- 451 continue
- else
- cold = cfile(:lfile)//'.flopold'
- lold = index(cold,' ')-1
- cbad = cold
- open(15,file=cold(:lold),status='unknown',err=999)
- endif
- c
- c loop over all qualifiers
- c
- icheck = 0
- do 500 iarg = 1,numargs-1
- call getarg(iarg,argval)
- larg = index(argval,' ')-1
- key = argval(2:2)
- if(key.eq.'l') then
- log = .true.
- else if(key.eq.'n') then
- if(argval(3:3).eq.' ') then
- write(6,'(A)') ' Floppy --> Missing value for -n'
- goto 900
- endif
- cfort = argval(3:)
- lfort = index(cfort,' ')-1
- if(log) write(6,'(A)') ' Floppy --> Tidied Fortran: '//
- & cfort(:lfort)
- else if(key.eq.'o') then
- c
- else if(key.eq.'f') then
- if(log) write(6,'(A)') ' Floppy --> List source line numbers'
- write(15,'(a)') '*FULL'
- else if(key.eq.'i') then
- ctemp = argval(3:)
- 50 iend = index(ctemp,',')
- if(iend.ne.0) then
- write(15,'(A)') ctemp(:iend-1)
- if(log) write(6,'(A)')
- & ' Floppy --> Ignore: '//ctemp(:iend-1)
- ctemp = ctemp(iend+1:)
- goto 50
- endif
- iend = index(ctemp,' ')
- write(15,'(A)') ctemp(:iend)
- if(log) write(6,'(A)') ' Floppy --> Ignore: '//ctemp(:iend)
- else if(key.eq.'c') then
- icheck = 1
- ctemp = argval(3:)
- if(ctemp.eq.'standard') then
- write(15,'(A)') '*CHECK RULE *'
- if(log) write(6,'(A)') ' Floppy --> Check Standard rules'
- else if(ctemp.eq.' ') then
- write(15,'(A)') '*CHECK RULE *'
- if(log) write(6,'(A)') ' Floppy --> Check Standard rules'
- else if(ctemp.eq.'a') then
- write(15,'(A)') '*CHECK RULE 99'
- if(log) write(6,'(A)') ' Floppy --> Check all rules'
- else if(ctemp.eq.'n') then
- write(15,'(A)') '*CHECK RULE -99'
- if(log) write(6,'(A)') ' Floppy --> No rule checks'
- else
- ctemp = ctemp(:index(ctemp,' ')-1)
- if(log) write(6,'(A)') ' Floppy --> Check rules: '//
- & ctemp(:index(ctemp,' ')-1)
- 51 iend = index(ctemp,',')
- if(iend.ne.0) then
- write(15,'(A)') '*CHECK RULE '//ctemp(:iend-1)
- ctemp = ctemp(iend+1:)
- goto 51
- endif
- write(15,'(A)') '*CHECK RULE '//ctemp
- endif
- else if(key.eq.'t') then
- write(7,'(A)') 'OPTIONS,TREE;'
- ctree = cfile(:lfile)//'.floptre'
- ltree = index(ctree,' ')-1
- if(log) write(6,'(A)')
- & ' Floppy --> Produce file for Flow: '//ctree(:ltree)
- open(50,file=ctree(:ltree),status='new',
- & form='unformatted',err=999)
- tree = .true.
- else if(key.eq.'j') then
- char = argval(3:3)
- if(char.eq.' ') char = '3'
- write(7,'(A)') 'OPTIONS,INDENT='//char//';'
- if(log) write(6,'(A)') ' Floppy --> Indent clauses by '//char
- tidy = .true.
- else if(key.eq.'f') then
- write(7,'(A)') 'STATEMENTS,SEPARATE;'
- if(log) write(6,'(A)') ' Floppy --> Group FORMATs at end'
- tidy = .true.
- else if(key.eq.'g') then
- write(7,'(A)') 'STATEMENTS,GOTO;'
- if(log) write(6,'(A)') ' Floppy --> Right align GOTOs'
- tidy = .true.
- else if(key.eq.'r') then
- ctemp = argval(3:)
- iend = index(ctemp,',')
- if (iend.eq.0) ctemp = ctemp(:index(ctemp,' ')-1)//',10'
- write(7,'(A)') 'STATEMENTS,FORMAT='//
- & ctemp(:index(ctemp,' ')-1)//';'
- if(log) write(6,'(A)') ' Floppy --> Renumber FORMATs: '//
- & 'start,step '//ctemp(:index(ctemp,' '))
- tidy = .true.
- else if(key.eq.'s') then
- ctemp = argval(3:)
- iend = index(ctemp,',')
- if (iend.eq.0) ctemp = ctemp(:index(ctemp,' ')-1)//',10'
- write(7,'(A)') 'STATEMENTS,NUMBER='//
- & ctemp(:index(ctemp,' ')-1)//';'
- if(log) write(6,'(A)') ' Floppy --> Renumber statements: '//
- & 'start,step '//ctemp(:index(ctemp,' '))
- tidy = .true.
- else
- write(6,'(A)') ' Floppy --> Unrecognized qualifier '//key
- endif
- 500 continue
- c
- if(tidy) then
- write(7,'(A)') 'OUTPUT,FULL,COMPRESS;'
- if(cfort(1:1).eq.' ') then
- cfort = cfile(:lfile)//'.out'
- lfort = index(cfort,' ')-1
- endif
- cbad = cfort
- open(14,file=cfort(:lfort),status='unknown',err=999)
- endif
- c
- c default action is to check standard rules
- c
- if(icheck.eq.0.and..not.fqold) then
- write(15,'(A)') '*CHECK RULE *'
- endif
-
- write(7,'(A)') 'END;'
- if(log) write(6,'(A)') ' Floppy --> Finished parsing command'
- rewind(7)
- rewind(15)
- cbad = cfile
- open(11,file=cfile(:lfile),status='old',err=999)
- cbad = 'scratch'
- open(99,status='scratch',err=999)
- c
- call allpro
- c
- close(11)
- if(tidy) close(14)
- if(tree) close(50)
- close(7)
- close(99)
- write(6,'(A)') ' Floppy --> has finished'
- goto 2000
- C
- 999 CONTINUE
- WRITE(6,'(A)') ' Floppy --> Error opening '//
- & cbad(:index(cbad,' '))
- 900 write(6,'(A)') ' Floppy aborted'
- 2000 CONTINUE
- END
-